home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / lib / w3m / cgi-bin / multipart.cgi < prev    next >
Text File  |  2008-07-21  |  6KB  |  314 lines
  1. #!/usr/bin/perl
  2.  
  3. eval "use NKF;";
  4. if (! $@) {
  5.     $use_NKF = 1;
  6.     $CONV = "-e";
  7.     $MIME_DECODE = "-m -e";
  8. } else {
  9.     $use_NKF = 0;
  10. #    $CONV = "w3m -dump -e";
  11.     $CONV = "/usr/local/bin/nkf -e";
  12.     $MIME_DECODE = "/usr/local/bin/nkf -m -e";
  13. }
  14. $MIME_TYPE = "$ENV{'HOME'}/.mime.types";
  15.  
  16. $SCRIPT_NAME = $ENV{'SCRIPT_NAME'} || $0;
  17. $CGI = "file://$SCRIPT_NAME";
  18.  
  19. if ($ENV{'REQUEST_METHOD'} eq 'POST') {
  20.     sysread(STDIN, $query, $ENV{'CONTENT_LENGTH'});
  21. } elsif (defined($ENV{'QUERY_STRING'})) {
  22.     $query = $ENV{'QUERY_STRING'};
  23. }
  24. if (defined($query)) {
  25.     for (split('&', $query)) {
  26.         s/^([^=]*)=//;
  27.         $v{$1} = $_;
  28.     }
  29.     $file = &form_decode($v{'file'});
  30.     $boundary = &form_decode($v{'boundary'});
  31. } else {
  32.     $file = $ARGV[0];
  33.     if (@ARGV >= 2) {
  34.         $boundary = $ARGV[1];
  35.     }
  36. }
  37. (-f $file) || exit(1);
  38. open(F, "< $file") || exit(1);
  39. $end = 0;
  40. $mbody = '';
  41. if (defined($boundary)) {
  42.     while(<F>) {
  43.         s/\r?\n$//;
  44.         ($_ eq "--$boundary") && last;
  45.         ($_ eq "--$boundary--") && ($end = 1, last);
  46.         $mbody .= "$_\n";
  47.     }
  48. } else {
  49.     while(<F>) {
  50.         s/\r?\n$//;
  51.         if (s/^\-\-//) {
  52.             $boundary = $_;
  53.             last;
  54.         }
  55.         $mbody .= "$_\n";
  56.     }
  57. }
  58.  
  59. if (defined($v{'count'})) {
  60.     $count = 0;
  61.     while($count < $v{'count'}) {
  62.         while(<F>) {
  63.             s/\r?\n$//;
  64.             ($_ eq "--$boundary") && last;
  65.         }
  66.         eof(F) && exit;
  67.         $count++;
  68.     }
  69.  
  70.     %header = ();
  71.     $hbody = '';
  72.     while(<F>) {
  73.         /^\s*$/ && last;
  74.         $x = $_;
  75.         s/\r?\n$//;
  76.         if (/=\?/) {
  77.             $_ = &decode($_, $MIME_DECODE);
  78.         }
  79.         if (s/^(\S+)\s*:\s*//) {
  80.             $h = $&;
  81.             if ($h =~ /^w3m-control/i) {
  82.                 $h = "WARNING: $h";
  83.             }
  84.             $hbody .= "$h$_\n";
  85.             $p = $1;
  86.             $p =~ tr/A-Z/a-z/;
  87.             $header{$p} = $_;
  88.         } elsif (s/^\s+//) {
  89.             chop $hbody;
  90.             $hbody .= "$_\n";
  91.             $header{$p} .= $_;
  92.         }
  93.     }
  94.     $type = $header{"content-type"};
  95.     $dispos = $header{"content-disposition"};
  96.     if ($type =~ /application\/octet-stream/) {
  97.         if ($type =~ /type\=gzip/) {
  98.             print "Content-Encoding: x-gzip\n";
  99.         }
  100.         if ($type =~ /name=\"?([^\"]+)\"?/ ||
  101.             $dispos =~ /filename=\"?([^\"]+)\"?/) {
  102.             $type = &guess_type($1);
  103.             if ($type) {
  104.                 print "Content-Type: $type; name=\"$1\"\n";
  105.             } else {
  106.                 print "Content-Type: text/plain; name=\"$1\"\n";
  107.             }
  108.         }
  109.     }
  110.     print $hbody;
  111.     print "\n";
  112.     while(<F>) {
  113.         $x = $_;
  114.         s/\r?\n$//;
  115.         ($_ eq "--$boundary") && last;
  116.         if ($_ eq "--$boundary--") {
  117.             last;
  118.         }
  119.         print $x;
  120.     }
  121.     close(F);
  122.     exit;
  123. }
  124.  
  125. $qcgi = &html_quote($CGI);
  126. $qfile = &html_quote($file);
  127. $qboundary = &html_quote($boundary);
  128.  
  129. if ($mbody =~ /\S/) {
  130.     $_ = $mbody;
  131.     s/\&/\&/g;
  132.     s/\</\</g;
  133.     s/\>/\>/g;
  134.     print "<pre>\n";
  135.     print $_;
  136.     print "</pre>\n";
  137. }
  138.  
  139. $count = 0;
  140. while(! $end) {
  141.     %header = ();
  142.     $hbody = '';
  143.     while(<F>) {
  144.         /^\s*$/ && last;
  145.         s/\r?\n$//;
  146.         if (/=\?/) {
  147.             $_ = &decode($_, $MIME_DECODE);
  148.         }
  149.         if (s/^(\S+)\s*:\s*//) {
  150.             $hbody .= "$&$_\n";
  151.             $p = $1;
  152.             $p =~ tr/A-Z/a-z/;
  153.             $header{$p} = $_;
  154.         } elsif (s/^\s+//) {
  155.             chop $hbody;
  156.             $hbody .= "$_\n";
  157.             $header{$p} .= $_;
  158.         }
  159.     }
  160.     $type = $header{"content-type"};
  161.     $dispos = $header{"content-disposition"};
  162.     $plain = 0;
  163.     $image = 0;
  164.     if (! $dispos || $dispos =~ /^inline/i) {
  165.         if (! $type || $type =~ /^text\/plain/i) {
  166.             $plain = 1;
  167.         } elsif ($type =~ /^image\//i) {
  168.             $image = 1;
  169.         }
  170.     }
  171.     $body = '';
  172.     while(<F>) {
  173.         s/\r?\n$//;
  174.         ($_ eq "--$boundary") && last;
  175.         if ($_ eq "--$boundary--") {
  176.             $end = 1;
  177.             last;
  178.         }
  179.         if ($plain) {
  180.             $body .= "$_\n";
  181.         }
  182.     }
  183.     $| = 1;
  184.     print "<hr>\n";
  185.     {
  186.         $_ = $hbody;
  187.         s/\&/\&/g;
  188.         s/\</\</g;
  189.         s/\>/\>/g;
  190.         print "<pre>\n";
  191.         print $_;
  192.         print "</pre>\n";
  193.         if ($type =~ /name=\"?([^\"]+)\"?/ ||
  194.             $dispos =~ /filename=\"?([^\"]+)\"?/) {
  195.             $name = $1;
  196.         } else {
  197.             $name = "Content";
  198.         }
  199.         print "<form action=\"$qcgi\">\n";
  200.         print "<input type=hidden name=file value=\"$qfile\">\n";
  201.         print "<input type=hidden name=boundary value=\"$qboundary\">\n";
  202.         print "<input type=hidden name=count value=\"$count\">\n";
  203.         if ($image) {
  204.             print "<input type=image name=submit src=\"$qcgi?file=",
  205.                 &html_quote(&form_encode($file)),
  206.                 "&boundary=",
  207.                 &html_quote(&form_encode($boundary)),
  208.                 "&count=$count\" alt=\"",
  209.                 &html_quote($name), "\">\n";
  210.         } else {
  211.             print "<input type=submit name=submit value=\"",
  212.                 &html_quote($name), "\">\n";
  213.         }
  214.         print "</form>\n"
  215.     }
  216.     if ($plain) {
  217.         $body = &decode($body, $CONV); 
  218.         $_ = $body;
  219.         s/\&/\&/g;
  220.         s/\</\</g;
  221.         s/\>/\>/g;
  222.         print "<pre>\n\n";
  223.         print $_;
  224.         print "</pre>\n";
  225.     }
  226.     eof(F) && last;
  227.     $count++;
  228. }
  229. close(F);
  230.  
  231. sub decode {
  232. if ($use_NKF) {
  233.     local($body, $opt) = @_;
  234.     return nkf($opt, $body);
  235. }
  236.     local($body, @cmd) = @_;
  237.     local($_);
  238.  
  239.     $| = 1;
  240.     pipe(R, W2);
  241.     pipe(R2, W);
  242.     if (! fork()) {
  243.         close(F);
  244.         close(R);
  245.         close(W);
  246.         open(STDIN, "<&R2");
  247.         open(STDOUT, ">&W2");
  248.         exec @cmd;
  249.         die;
  250.     }
  251.     close(R2);
  252.     close(W2);
  253.     print W $body;
  254.     close(W);
  255.     $body = '';
  256.     while(<R>) {
  257.         $body .= $_;
  258.     }
  259.     close(R);
  260.     return $body;
  261. }
  262.  
  263. sub html_quote {
  264.   local($_) = @_;
  265.   local(%QUOTE) = (
  266.     '<', '<',
  267.     '>', '>',
  268.     '&', '&',
  269.     '"', '"',
  270.   );
  271.   s/[<>&"]/$QUOTE{$&}/g;
  272.   return $_;
  273. }
  274.  
  275. sub form_decode {
  276.   local($_) = @_;
  277.   s/\+/ /g;
  278.   s/%([\da-f][\da-f])/pack('c', hex($1))/egi;
  279.   return $_;
  280. }
  281.  
  282. sub form_encode {
  283.   local($_) = @_;
  284.   s/[\000-\040\+:#?&%<>"\177-\377]/sprintf('%%%02X', unpack('C', $&))/eg;
  285.   return $_;
  286. }
  287.  
  288. sub guess_type {
  289.     local($_) = @_;
  290.  
  291.     /\.(\w+)$/ || return "";
  292.     $_ = $1;
  293.     tr/A-Z/a-z/;
  294.     %mime_type = &load_mime_type($MIME_TYPE);
  295.     $mime_type{$_};
  296. }
  297.  
  298. sub load_mime_type {
  299.     local($file) = @_;
  300.     local(%m, $a, @b, $_);
  301.  
  302.     open(M, "< $file") || return ();
  303.     while(<M>) {
  304.         /^#/ && next;
  305.         chop;
  306.         (($a, @b) = split(" ")) >= 2 || next;
  307.         for(@b) {
  308.             $m{$_} = $a;
  309.         }
  310.     }
  311.     close(M);
  312.     return %m;
  313. }
  314.